<!--#include file="../inc/conn.asp"-->
<!--#include file="../inc/system31.asp"-->
<!--#include file="../inc/system35.asp"-->
<!--#include file="../inc/htmlasp.asp"-->
<!--#include file="../inc/bbcode.asp"-->
<!--#include file="../inc/md5.asp"-->


<!--#include file="../class/Catelog.asp"-->
<!--#include file="../class/Info.asp"-->
<!--#include file="../class/Reply.asp"-->
<!--#include file="../class/Link.asp"-->
<!--#include file="../class/User.asp"-->
<!--#include file="../class/Cemplate.asp"-->


<%

Function ApplicationRun()
	Call LoadTplConfig(server.mappath("../") & "\")
	Dim saction
	saction = trim(request("action"))
	select case saction
		case "cat"	:call action_cat()
		case "link"	:call action_link()
		case "info"	:call action_info()
		case "logout":call action_logout()
		case "base"		:call action_base()
		case "user"		:call action_user()
		case "data"		:call action_data()
		case "html"		:call action_html()
		Case Else	:call action_default()
	End select 
End Function 
'


Function action_default() 
	response.write("启动选项 :")
End Function

Function action_base_default() 
	response.write("个人参数")
End Function 

'--------------------------------------------------------
Function action_logout()
	call UserLogout(UserConstArr())
	response.write (CoutError(1,"退出成功,3秒返回首页."))
	response.write (CoutError(6,"../"))

End Function 
Function action_base()
	Dim sthat
	sthat = trim(request("that"))
	select case sthat
		case "globalini":call action_base_globalini()
		Case Else		:call action_base_default()
	End select 
End Function 

Sub action_data()
	Select Case Trim(request("that"))
	Case "bankup"
		Call action_data_bankup()
	Case "Restore"
		Call action_data_Restore()
	Case "Compact"
		Call action_data_Compact()
	Case "local"
		Call action_data_local()
	case else
			Call action_data_view()

	End Select 
End Sub 



Sub action_data_view()%>
<table width="100%" border="1">
<tr style="background-color:#ddd;font-weight:700;color:#000080"><td>分类</td><td>占用空间</td><td>大小(M)</td></tr>

<tr><td>总共</td><td><img src="images/bar.gif" width="<%=drawbar("../")%>%" height=10 /></td><td><%=showSpaceinfo("../")%></td></tr>

<tr><td>数据库</td><td><img src="images/bar.gif" width="<%=drawbar(DbPath)%>%" height=10 /></td><td><%=showSpaceinfo(DbPath)%></td></tr>

<tr><td>上传</td><td><img src="images/bar.gif" width="<%=drawbar(SaveUpFilesPath)%>%" height=10 /></td><td><%=showSpaceinfo(SaveUpFilesPath)%></td></tr>

<tr><td>后台</td><td><img src="images/bar.gif" width="<%=drawbar("./")%>%" height=10 /></td><td><%=showSpaceinfo("./")%></td></tr>

</table>
<%End Sub
Sub action_data_bankup()
If Trim(request("submit"))<>"" Then 
	dim bkfolder,bkdbname,ErrMsg,FoundErr,fso
	bkfolder=trim(request("path"))
	bkdbname=trim(request("newpath"))
	if bkfolder="" then
		FoundErr=True
		response.write (CoutError(9,"请指定备份目录！"))
	end if
	if bkdbname="" then
		FoundErr=True
		response.write (CoutError(9,"请指定备份文件名"))
	end if
	if FoundErr=True then 
 	exit Sub
	End If 
	bkfolder=server.MapPath(DbPath)&"/"&bkfolder
 	Set fso=server.createobject("scripting.filesystemobject")
	if fso.FileExists(bkfolder) then
		If fso.FolderExists(server.mappath(DbPath&"/data_bak"))=false Then
			fso.CreateFolder(server.mappath(DbPath&"/data_bak"))
		end if
		fso.copyfile bkfolder,Replace(server.mappath(DbPath&"/data_bak")&"/","//","/")&bkdbname
		response.write (CoutError(1,"备份数据库成功，备份的数据库为" & DbPath&"/data_bak/"&bkdbname& ""))
		response.write (CoutError(6,"default.asp?action=data "))

	Else
		response.write (CoutError(9,"数据库没有找到!"))
	End If
	
Else%>
<form name="form" action="default.asp?action=data&that=bankup" method="post" class="admin_post_form">
<label>被备份的数据库名称:<input name="path" value="<%=TrueDbName%>" size="20"/>新名称:<input name="newpath" value="<%response.write date()&".mdb"%>" size="20"/><input type="submit" name="submit" class="submit" value="确定操作"/></label>
</form>

<%End If 
End Sub 
sub action_data_Compact()
Dim strDBPath
strDBPath=Replace(server.mappath("../")&"\","//","\") & "data\"
If Trim(request("submit"))<>"" And  Trim(request("path"))<>"" Then 
	'on error resume next 
	Dim fso, Engine, path

	path=strDBPath&Trim(request("path"))
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	If FileExists(path) Then
		Set conn=Nothing '断开链接数据库
		Set Engine = CreateObject("JRO.JetEngine")
		Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & path ," Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb"
		fso.CopyFile strDBPath & "temp.mdb",path
		fso.DeleteFile(strDBPath & "temp.mdb")
		Set fso = nothing
		Set Engine = nothing
		if err then 
			response.write (CoutError(1,Err.Description ))
			err.clear
		Else
			response.write (CoutError(1,"数据库压缩成功!"))
		End if 
		response.write (CoutError(6,"default.asp?action=data"))
	Else
		response.write (CoutError(9,"数据库没有找到!"))
	End If
Else%>
<form name="form" action="default.asp?action=data&that=Compact" method="post" class="admin_post_form">
<label>被压缩的数据库名称:<%=strDBPath%><input name="path" value="<%=TrueDbName%>" size="20"/><input type="submit" name="submit" class="submit" value="确定操作"/></label>
</form>

<%End If 
End sub
sub action_data_Restore()

If Trim(request("submit"))<>"" And  Trim(request("path"))<>""  And  Trim(request("newpath"))<>"" Then 
	dim bkfolder,bkdbname,basedb,fso
	basedb=server.MapPath(DbPath)
	bkfolder=Replace(basedb&"/","//","/")&trim(request("path"))
	bkdbname=Replace(basedb&"/","//","/")&trim(request("newpath"))
	Set fso=server.createobject("scripting.filesystemobject")
	if fso.FileExists(bkdbname) then
		If fso.FolderExists(server.mappath(DbPath))=false Then
			fso.CreateFolder(server.mappath(DbPath))
		end if
		fso.copyfile bkdbname,bkfolder
		response.write (CoutError(1,"还原数据库成功，还原的数据库为 " &bkfolder& ""))
		response.write (CoutError(6,"default.asp?action=data"))
	Else
		response.write (CoutError(9,"找不到还原数据库文件来源，请检查的配置"))
	End If	


Else%>
<form name="form" action="default.asp?action=data&that=Restore" method="post"  >
<label>被还原的数据库名称:<input name="path" value="<%=TrueDbName%>" size="15"/>来自:<input name="newpath" value="/data_bak/<%response.write date&".mdb"%>" size="45"/><input type="submit" name="submit" class="submit" value="确定操作"/></label>
</form>

<%End If

end Sub
Sub action_data_local()
	'on error resume next 
	If Trim(request("submit"))<>"" And  Trim(request("path"))<>""   Then 
	dim bkfolder,bkdbname,basedb,fso,downpath
	downpath=trim(request("path"))
	basedb=server.MapPath(DbPath)
	bkfolder=Replace(basedb&"\","\\","\")&downpath
	Set fso=server.createobject("scripting.filesystemobject")
	if fso.FileExists(bkfolder) Then
		Set conn=Nothing 
		'response.write (bkfolder)
		'response.write (ReadBinaryFile(bkfolder))
		'response.End 
		Response.Buffer = True   
		Response.Clear   
		Response.AddHeader "Content-Disposition", "attachment;filename="& downpath&""'文件名
		'Response.ContentType = "application/x-msAccess" '设置（1）
		response.Binarywrite ReadBinaryFile(bkfolder)'

		Response.Flush
		'response.write (CoutError(1,"请在弹出窗口中下载."))
		'response.write (CoutError(6,"default.asp?action=data"))

	Else
		response.write (CoutError(9,"找不到源数据库文件来源，请检查的配置"))
	End If	



Else%>
<form name="form" action="default.asp?action=data&that=local&putout=false" method="post" target="" >
<label>要下载的数据库名称:<input name="path" value="<%=TrueDbName%>" size="15"/><input type="submit" name="submit" class="submit" value="确定操作"/></label>
</form>

<%End If
End Sub 




Function action_base_globalini()
	
	'If(Not IsValidAspCode(configFile)) Then 
		'其实这种情况不会出现，在打开后台的时候就报错了
		'而且asp文件中包含的是CONST变量，这还会导致重命名错误
	'	response.write("<font color=red>无法加载用户配置文件</font>")
	'	response.End 
	'End If 

	if trim(request("submit"))<>"" then 
		Dim configFile 
		configFile = Tpl.GetValue("BasePath") & "inc/constConfig.asp"
		Dim objItem,outMessage
		outMessage="<%"  
		For Each objItem In Request.Form 
			If(BeginWith(objItem,"str_")) Then 
				outMessage  = outMessage & vbcrlf & "Const " & Mid(objItem,5 ) & "= """ & GetIniData("String",Request.Form(objItem),"  ") & """"
			ElseIf (BeginWith(objItem,"int_")) Then 
				outMessage  = outMessage & vbcrlf & "Const " & Mid(objItem,5) & "= " & GetIniData("Int",Request.Form(objItem),0) 
			ElseIf (BeginWith(objItem,"bool_")) Then 
				outMessage  = outMessage & vbcrlf & "Const " & Mid(objItem,6) & "= " & GetIniData("Bool",Request.Form(objItem),false) 
			End If 
		Next 
		outMessage= outMessage & vbcrlf & "%" & ">"
		Call WriteTo( configFile, outMessage)
		If Not NeedHtmlPage Then '如果不生成静态页，删除首页
			DeleteFile Tpl.GetValue("BasePath") & "index.html"
		else
			CreateCemplateHtml Tpl.GetValue("BasePath") & TemplateBasePath & "\default.asp"  ,True 
		End if
		response.write (CoutError(1,"操作成功,3秒后返回上一页"))
		response.write (CoutError(6,"default.asp?action=base&that=globalini"))
	else
		'输出表单
		GlobalIniHtmlForm()
	End if 
End Function 
Function GetIniData(Casetype,str,formatTo)
	Dim rValue
	Select Case Casetype
		Case "Bool":
			If(VarType(str)=11) Then 
				rValue= str
			ElseIf ( LCase(CStr(str))="true") Then 
				rValue= True 
			ElseIf ( LCase(CStr(str))="false") Then 
				rValue= False 
			Else
				rValue= formatTo
			End If 
		Case "Int":
			If(IsInteger(str)) Then 
				rValue = killint(str,formatTo,formatTo,10)
			Else
				rValue = formatTo
			End If 
		Case else:
				rValue= Replace(HTMLEncode(str),"""","""""")
	End Select 
	GetIniData = rValue 
End Function 
Function AdminInfoDes()
	Dim mess
	mess = ("<ul><li>ID:"&GetUserData(UserLoginID)&"</li><li>用户名:"&GetUserData(UserLoginName)&"</li><li>级别:"&GetUserData(UserLoginLevel)&"</li></ul>")
	AdminInfoDes = mess 
End Function 
Function action_html()
	Dim sthat
	sthat = trim(request("that"))
	select case sthat
		case "exe"		:
		If NeedHtmlPage Then 
			call action_html_create()
		Else
			response.write CoutError(1,"系统设置不生成静态页，三秒后返回")
			response.write (CoutError(6,"default.asp?action=html"))
		End If 
		Case Else		:call action_html_list()
	End select 
End Function 
Sub action_html_list()
	If (Not NeedHtmlPage) Then 
		response.write CoutError(1,"警告：目前系统设置不支持静态页生成，所有的页面生成操作将无效")
	End If 
%>
<form name='Catform' style="display:block;clear:both" action='default.asp?action=html&that=exe' method='post'>
<table width='100%' class='tablelist' border='0' cellpadding='3' cellspacing='1' >
	<tr class='tableheader' ><td width='15%'>模板文件名</td><td  width='70%'  align='left'>描述</td><td width='5%'><input  type='checkbox'  name='chkall'  value='on'  onclick='CheckAll(this.form)'></td></tr>
	<tr><td>default.asp</td><td align='left'>blog系统的首页</td><td><input name='id' type='checkbox' value='default.asp'/></td></tr>
	<tr><td>sitemap.asp</td><td align='left'>SiteMap文件 </td><td><input name='id' type='checkbox' value='sitemap.asp'/></td></tr>

<tr><td colspan='3' class='tablespan'><input type='submit' name='Submit' class='submit' value='生成' onClick="return cofimstr('全部重新生成么');"></td></tr></table></form>
<%
End Sub 
Function action_html_create()
	Dim strID,oInfo,bak_key,objt
	bak_key = killint(Request("bak_key"),0,0,10)
	If Len(Request("id"))>3 Then 


	For  Each    strID  In  Request("id")  
		
			'生成html文件
		Dim baseDirTemp
		baseDirTemp=server.mappath("../") & "\"  
		Dim xempFile
		xempFile=baseDirTemp & TemplateBasePath & "\" & strID  

		Call CreateCemplateHtml(xempFile,true)
		response.write("<br/>")
	Next 

	End If 
		response.write("<br/>操作成功<br/>")
		response.write (CoutError(6,"default.asp?action=html"))
End Function 
Function action_cat()
	Dim sthat
	sthat = trim(request("that"))
	select case sthat
		case "add"		:call action_cat_add()
		case "edit"		:call action_cat_edit()
		case "move"		:call action_cat_move()
		case "count"	:call action_cat_count()
		case "delete"	:call action_cat_delete()
		case "bak"		:call action_cat_bak()
		Case Else		:call action_cat_list()
	End select 
End Function 
Function action_cat_bak()
	If NeedHtmlPage Then 
		Dim strID,bak_key,strFilePath
		bak_key = killint(Request("bak_key"),0,0,10)
		
		Dim proNum
		proNum = killint(request("proNum"),0,0,3)
		If(proNum = 0) Then 
			Tpl.Assign "MustPageAll",True  
		Else
			Tpl.Assign "MustPageAll",False 
			Tpl.Assign "StopPageNumber",proNum  		
		End If 
		For  Each    strID  In  Request("id")  
			Call Tpl.Assign("SectedID",strID)
			'CreateFolder( )
			Call CreateCemplateHtml(server.mappath("../") & "\" & "template\dir-index.asp",true)
		Next
		response.write CoutError(1,"批量操作成功,3秒后返回")
	Else
		response.write CoutError(1,"系统设置不生成静态页，三秒后返回")
	End If 
		response.write CoutError(6,"default.asp?action=cat")
End Function 
Sub  action_cat_list()
		Dim oCatelog,acatarr,stablemess,ir
		Set oCatelog = new Catelog
		oCatelog.PIcatMdb	= ConstDBtablearr(0)
		acatarr = oCatelog.GetCatAll()
		stablemess	= "<form name='Catform' action='default.asp?action=cat&that=bak' method='post'><table width='100%' class='tablelist' border='0' align='center' cellpadding='3' cellspacing='1' ><tr class='tableheader' ><td width='5%'>序号</td><td width='20%'>名称</td><td width='20%'>所属</td><td width='10%'>路径</td><td width='10%'>加密</td><td width='5%'>级别</td><td width='15%'>操作</td><td width='5%'><input  type='checkbox'  name='chkall'  value='on'  onclick='CheckAll(this.form)'></td></tr>"

		for ir = 0 to ubound(acatarr,2)
			Dim cid,ctext
			cid=acatarr(3,ir)
			If(cid<>0) Then 
				ctext = GetCatName(cid)
			Else
				ctext = "------"
			End If 
			stablemess = stablemess & "<tr class='tabletr' ><td>"&acatarr(0,ir)&"</td><td>"&acatarr(1,ir)&"</td><td>"&  ctext &"</td><td>"&acatarr(5,ir)&"</td><td>"&acatarr(4,ir)&"</td><td>"&acatarr(2,ir)&"</td><td><img src='../images/admin/up.gif'  border='0' alt='上移'>&nbsp;<img src='../images/admin/Dn.gif'  border='0' alt='下移'>&nbsp;<a href='default.asp?action=cat&that=edit&id="&acatarr(0,ir)&"'><img src='../images/admin/edit.gif'  border='0' alt='操作'></a>&nbsp;<a href='default.asp?action=cat&that=delete&id="&acatarr(0,ir)&"'  onClick=""return cofimstr('进行删除操作么');""><img src='../images/admin/delete.gif'  border='0' alt='删除'></a>&nbsp;&nbsp;<a href='default.asp?action=info&cat_id="&acatarr(0,ir)&"'><img src='../images/admin/Refresh.gif'  border='0' alt='栏目下信息'></a> </td><td><input name='id' type='checkbox' value='"&acatarr(0,ir)&"'></td></tr>"
		next
		stablemess = stablemess &"<tr><td class='tablespan'><font color='blue'>-"&ubound(acatarr,2)+1&"-</font></td><td  colspan='7' class='tablespan'>"
		If (NeedHtmlPage) Then 
			stablemess = stablemess & "<select onchange=""$('proNum').value=this.options[this.options.selectedIndex].value""><option value='1'>只处理第一页</option><option value='3'>处理至第3页</option><option value='5'>处理至第5页</option><option value='10'>处理至第10页</option><option value='0'>全部处理</option></select><input name='proNum' style='width:18px' id='proNum' value='1'/><input type='submit' name='Submit' class='submit' value='批处理' onClick=""return cofimstr('进行批处理么');"">"
		End if

		stablemess = stablemess & "</td></tr></table></form>"
		response.write(stablemess)
		Set oCatelog = nothing 
End Sub  
Sub action_cat_delete()
		Dim oCatelog
		Set oCatelog = new Catelog
		oCatelog.PIcatMdb	= ConstDBtablearr(0)'栏目的表格
		
		Dim oInfo,pageall,cat_id
		Set oInfo = new Info
		oInfo.PInfoMdb	= ConstDBtablearr(1)
		cat_id= killint(trim(request("id")),0,0,5)
		pageall=killint( oInfo.GetAllResult(cat_id),0,0,10)

		if pageall>0 then 
			response.write (CoutError(1,"该栏目下面有数据，无法直接删除栏目"))
			response.write (CoutError(6,"default.asp?action=info&cat_id="&cat_id&""))
			exit Sub
		End if
		if oCatelog.Delete(cat_id) then 
			DeleteFolder(Tpl.GetValue("BasePath") & GetCataloguePath( cat_id ))
			call MakeAppData(1)
			response.write (CoutError(1,"删除操作成功"))
		else
			response.write (CoutError(9,"提交失败，可能由于记录已经存在了."))
		End if 
		Set oCatelog = nothing 
			response.write (CoutError(6,"default.asp?action=cat"))
End Sub 
Sub action_cat_add()
	if trim(request("submit"))<>"" then 
		Dim cat_name,cat_parent,cat_level,cat_other
		cat_name = trim(request("cat_name"))
		cat_parent = killint(trim(request("cat_parent")),0,0,5)
		cat_level = killint(trim(request("cat_level")),0,0,5)
		cat_other = killint(trim(request("cat_other_text")),0,0,10)
		if killint(trim(request("cat_other")),0,0,5)=0 then cat_other=0

 
		Dim oCatelog
		Set oCatelog = new Catelog
		oCatelog.PIcatMdb	= ConstDBtablearr(0)'栏目的表格
		if oCatelog.AddNew(Array(cat_name,cat_level,cat_parent,cat_other,Replace(request("cat_path"),"'",""))) then 
			call MakeAppData(1)
			response.write (CoutError(1,"操作成功,3秒后返回上一页"))
		else
			response.write (CoutError(9,"操作失败，可能由于记录已经存在了."))

		End if 
		Set oCatelog = nothing 

		response.write (CoutError(6,"default.asp?action=cat"))
	else%>
		<form name='form'  method="post"  action="default.asp?action=cat&that=add" onsubmit="return CheckForm(this)">
		<table width='100%' class='tablelist' border='0' align='center' cellpadding='3' cellspacing='1' >
		<tr class='tabletr' ><td width='10%'>名称:</td><td width='90%' align="left"><input type="text" name="cat_name"   check=".{1,20}." warning="名称不能是空，在1-20字符之间"  value=""/>
		<font color="#FF0B0B"><b>长度限制：1-20</b></font>
		</td></tr>
		<tr class='tabletr' ><td >所属:</td><td  align="left">
		<select name="cat_parent" style="width:100px"><%=CatOption(0,3)%></select>
		</td></tr>

		<tr class='tabletr' ><td >排序:</td><td align="left"> 
		<input type="text" name="cat_level"   check="^[0-9]{1,10}$" warning="排序级别不正确，必须是数字"  value="" /><font color="#FF0B0B"><b>必须是数字</b></font></b></font>
		</td></tr>

		<tr class='tabletr' ><td >路径:</td><td align="left"> 
		<input type="text" name="cat_path"   check="^[a-zA-Z0-9]{0,50}$" warning="路径必须是a-zA-Z的长度最大为50的字符"  value="" /><font color="#FF0B0B"><b>必须是a-zA-Z0-9的长度最大为50的字符</b></font></b></font>
		</td></tr>
		
		<tr class='tabletr' ><td >额外:</td><td align="left"><input type="checkbox" name="cat_other" id="cat_other" value="1" onclick="LockText(this)" ><label for="cat_other">超级加锁</label>
		<span id="locktext" style="display:none"> <input type="text" name="cat_other_text" value="" /></span>

		</td></tr>
		

		<tr><td colspan='2' class='tablespan'><input type='submit' name='submit' class='submit' value='提交' ></td></tr>
		</table>
		</form>
<%	End if 
End Sub 
Sub action_cat_edit()
		Dim oCatelog
		Set oCatelog = new Catelog
		oCatelog.PIcatMdb	= ConstDBtablearr(0)'栏目的表格
		Dim arrs,rid
		rid=killint(request("id"),0,0,10)
		if len(trim(request("submit"))) = 0  then 
		arrs= oCatelog.GetById(rid)
		if not isarray(arrs) then 
			response.write (CoutError(1,"获取数据失败"))
			exit Sub 
		End if %>
		<form name='form'  method="post"  action="default.asp?action=cat&that=edit&id=<%=arrs(0,0)%>" onsubmit="return CheckForm(this)">
		<table width='100%' class='tablelist' border='0' align='center' cellpadding='3' cellspacing='1' >
		<tr class='tabletr' ><td width='10%'>名称:</td><td width='90%' align="left"><input type="text" name="cat_name"   check=".{1,20}." warning="名称不能是空，在1-20字符之间"  value="<%=arrs(1,0)%>"/>
		<font color="#FF0B0B"><b>长度限制：1-20</b></font>
		</td></tr>
		<tr class='tabletr' ><td >所属:</td><td  align="left">
			<select name="cat_parent" style="width:100px"><%=CatOption(arrs(3,0),3)%></select>
		</td></tr>

		<tr class='tabletr' ><td >排序:</td><td align="left"> 
		<input type="text" name="cat_level"   check="^[0-9]{1,10}$" warning="排序级别不正确，必须是数字"  value="<%=arrs(2,0)%>" /><font color="#FF0B0B"><b>必须是数字</b></font></b></font>
		</td></tr>
		
		<tr class='tabletr' ><td >路径:</td><td align="left"> 
		<input type="text" name="cat_path"   check="^[a-zA-Z0-9]{0,50}$" warning="路径必须是a-zA-Z的长度最大为50的字符"  value="<%=arrs(5,0)%>" /><font color="#FF0B0B"><b>必须是a-zA-Z0-9的长度最大为50的字符</b></font></b></font>
		</td></tr>
		
		<tr class='tabletr' ><td >额外:</td><td align="left"><input type="checkbox" name="cat_other" id="cat_other" value="1" onclick="LockText(this)" <%if killint(arrs(4,0),0,0,10) > 0 then response.write("checked")%> ><label for="cat_other">超级加锁</label>
		<span id="locktext" style="<%if killint(arrs(4,0),0,0,10)  = 0 then response.write("display:none")%>"> <input type="text" name="cat_other_text" value="<%=arrs(4,0)%>" /></span>

		</td></tr>




		<tr><td colspan='2' class='tablespan'><input type='submit' name='submit' class='submit' value='提交' ></td></tr>
		</table>
		</form>
		<%else'提交数据库，更新数据库
		Dim cat_name,cat_parent,cat_level,cat_other
		cat_name = trim(request("cat_name"))
		cat_parent = killint(trim(request("cat_parent")),0,0,5)
		cat_level = killint(trim(request("cat_level")),0,0,5)
		cat_other = killint(trim(request("cat_other_text")),0,0,10)
		if killint(trim(request("cat_other")),0,0,5)=0 then cat_other=0

		if oCatelog.Edit(Array(rid,cat_name,cat_level,cat_parent,cat_other,Replace(request("cat_path"),"'",""))) then 
			call MakeAppData(1)
			response.write (CoutError(1,"操作成功,3秒后返回上一页"))
		else
			response.write (CoutError(9,"操作失败，可能由于记录已经存在了."))
		End if 
			response.write (CoutError(6,"default.asp?action=cat"))
		End if
		Set oCatelog = nothing 
End Sub 
'日志管理
Function action_info()
	Dim sthat
	sthat = trim(request("that"))
	select case sthat
		case "add"		:call action_info_add()
		case "edit"		:call action_info_edit()
		case "move"		:call action_info_move()
		case "count"	:call action_info_count()
		case "delete"	:call action_info_delete()
		case "bak"		:call action_info_bak()
		case "reply"		:call action_reply()
		Case Else		:call action_info_list()
	End select 
End Function 

sub action_reply()
		Dim oReply,ainfoarr,stablemess,ir,cat_id,page
		Set oReply = new Reply
		oReply.PThisMdb	= ConstDBtablearr(3)
		oReply.pPageLimit	= PageLimit
		page = killint(trim(request("page")),0,0,10)
		ainfoarr = oReply.GetLimitInfo(page,"")
		stablemess	= "<form name='form' action='default.asp?action=info&that=bak' method='post'><table width='100%' class='tablelist' border='0' align='center' cellpadding='3' cellspacing='1' ><tr class='tableheader' ><td width='5%'>序号</td><td width='5%'>主题</td><td width='10%'>标题</td><td width='35%'>内容</td><td width='23%'>时间</td><td width='17%'>Ip</td><td width='5%'><input  type='checkbox'  name='chkall'  value='on'  onclick='CheckAll(this.form)'></td></tr>"
		if not isarray(ainfoarr) then 
			response.write (CoutError(1,"查询无数据记录"))
			exit sub
		End if
		
		for ir = 0 to ubound(ainfoarr,2)
			stablemess = stablemess & "<tr class='tabletr' ><td>"&ainfoarr(0,ir)&"</td><td><a href=""default.asp?action=info&that=edit&id="&ainfoarr(1,ir)&""">"&ainfoarr(1,ir)&"</a></td><td align='left'>"&HTMLEncode(ainfoarr(2,ir))&"</td><td align=""left"">"&server.htmlencode(cutstr(ainfoarr(3,ir),AdminReplyCut))&"</td><td>"&ainfoarr(4,ir)&"</td><td>"&ainfoarr(5,ir)&"</td><td><input name='id' type='checkbox' value='"&ainfoarr(0,ir)&"'></td></tr>"
		next
		Dim pageall:pageall= oReply.GetAllResult("")

		stablemess = stablemess &"<tr><td colspan='7' class='tablespan' >"&PageInfo(GetPageCount(pageall,PageLimit),PageLimit,page,pageall)&"</td></tr><tr><td colspan='7'><input type='radio' name='bak_key' id='bak_key7' value='7'><label for='bak_key7'>删除</label><input type='radio' name='bak_key' value='0' style='display:none'><input type='submit' name='Submit' class='submit' value='批处理' onClick=""return cofimstr('进行批处理么');""></td></tr></table></form>"
		response.write(stablemess)
		Set oReply = nothing 
	
End Sub
sub action_info_list()
		Dim oInfo,ainfoarr,stablemess,ir,cat_id,page,TempPageInt
		TempPageInt = 16 
		Set oInfo = new Info
		oInfo.PInfoMdb	= ConstDBtablearr(1)
		oInfo.pPageLimit	= TempPageInt
		cat_id =  request("cat_id")
		page = killint(trim(request("page")),0,0,10)
		ainfoarr = oInfo.GetLimitInfo(page,cat_id)
		stablemess	= "<form name='form' action='default.asp?action=info&that=bak' method='post'><table width='100%' class='tablelist' border='0' align='center' cellpadding='3' cellspacing='1' ><tr class='tableheader' ><td width='5%'>序号</td><td width='10%'>大类</td><td width='30%'>标题</td><td width='20%'>时间</td><td width='5%'>点击</td><td width='20%'>路径</td><td width='5%'>操作</td><td width='5%'><input  type='checkbox'  name='chkall'  value='on'  onclick='CheckAll(this.form)'></td></tr>"
		if not isarray(ainfoarr) then 
			response.write (CoutError(1,"查询无数据记录"))
			exit sub
		End if

		for ir = 0 to ubound(ainfoarr,2)
			stablemess = stablemess & "<tr class='tabletr' ><td>"&ainfoarr(0,ir)&"</td><td><a href='default.asp?action=info&page="&page&"&cat_id="&ainfoarr(1,ir)&"'>"&GetCatName(ainfoarr(1,ir))&"</td><td align='left'>"&CutStr(ainfoarr(2,ir),CutWord)&"</td><td>"&ainfoarr(3,ir)&"</td><td>"&ainfoarr(4,ir)&"</td><td>"&ainfoarr(5,ir)&"</td><td><a href='default.asp?action=info&that=edit&id="&ainfoarr(0,ir)&"'><img src='../images/admin/edit.gif'  border='0' alt='操作'></a>&nbsp;<a href='default.asp?action=info&that=delete&id="&ainfoarr(0,ir)&"'  onClick=""return cofimstr('进行删除操作么');""><img src='../images/admin/delete.gif'  border='0' alt='删除'></a></td><td><input name='id' type='checkbox' value='"&ainfoarr(0,ir)&"'></td></tr>"
		next
		Dim pageall:pageall= oInfo.GetAllResult(cat_id)

		stablemess = stablemess &"<tr><td colspan='9' class='tablespan' >"&PageInfo(GetPageCount(pageall,TempPageInt),TempPageInt,page,pageall)&"</td></tr><tr><td colspan='8'>"
		If (NeedHtmlPage) Then 
			stablemess = stablemess & "<input type='radio' name='bak_key' id='bak_key7' value='1'><label for='bak_key7'>生成</label>"
		End if
		stablemess = stablemess & "<input type='radio' name='bak_key' id='bak_key2' value='2'><label for='bak_key2'>删除</label><input type='radio' name='bak_key' value='0' style='display:none'><input type='submit' name='Submit' class='submit' value='批处理' onClick=""return cofimstr('进行批处理么');""></td></tr></table></form>"
		response.write(stablemess)
		Set oInfo = nothing 
	
End Sub

Sub action_info_add()
	Dim postarr(13,0)
	'	redim postarr(10)'preserve
	if trim(request("submit"))<>"" then 
		Dim oInfo,info_title,info_content,cat_id,info_weather,info_rank,info_level,info_htmlorubb,info_tags,info_filename
		info_title = request("info_title")
		cat_id = killint(trim(request("cat_id")),0,0,5)
		info_rank = killint(trim(request("info_rank")),0,0,5)
		info_weather = killint(trim(request("info_weather")),0,0,5)
		
		info_level = killint(trim(request("info_level")),0,0,5)
		info_htmlorubb = killint(trim(request("info_ubbhtml")),0,0,5)

		info_tags = Left(request("form_tags"),250)
		info_filename = Left(request("form_htmlfile"),250)


		if info_htmlorubb = 0  then
			info_content= request("message")'UBB格式
		else
			info_content =  request("info_content")
		End if 

		Set oInfo = new Info
		oInfo.PInfoMdb	= ConstDBtablearr(1)
		
		if oInfo.AddNew(Array(0,cat_id,GetUserData(UserLoginID),info_level,info_title,info_weather,info_rank,info_content,GetIp(),info_htmlorubb,info_filename,info_tags)) then 

			Dim info_id
			
			info_id = oInfo.GetLasiInfoIDByUser(GetUserData(UserLoginID))
		If NeedHtmlPage Then 
			'更新静态页面

			'更新HTML
			oInfo.CreateXmlFile( info_id )'创建XML文件
			Call CreateInfomationItemHtml( info_id ,True )	'
			Tpl.Assign "MustPageAll",True    '只关心栏目的首页就可以了...
			Tpl.Assign "StopPageNumber",2   '中止页数设置成2，保证不叠加...
			'更新相关栏目页面
			Dim iPosParentIDs,iPosChildIDs,iPosCIDs
			iPosChildIDs = GetWithChildsInIDs( cat_id )
			iPosParentIDs = GetWithParentsInIDs( cat_id )
			
			iPosCIDs = RemoveTrim(Replace(Replace( Replace(Replace(Replace( iPosChildIDs & iPosParentIDs ,")","," ),"(",","),",,",","),"0,",""), cat_id& ",",""),",")
			Dim newCArrays,cIDIns
			newCArrays=Split(iPosCIDs,",")
			For each cIDIns In newCArrays
				If(IsInteger(cIDIns)) Then 
					Call Tpl.Assign("SectedID",cIDIns)
					Call CreateCemplateHtml(server.mappath("../") & "\" & "template\dir-index.asp",True )
				End If 
			Next
			'更新本栏目页面

			Call Tpl.Assign("SectedID",cat_id)
			Call CreateCemplateHtml(server.mappath("../") & "\" & "template\dir-index.asp",True )

			'更新代码结束
		End If 

			response.write (CoutError(1,"操作成功,3秒后返回上一页"))
			response.write (CoutError(6,"default.asp?action=info"))
		else
			response.write (CoutError(9,"提交失败,可能由于字段不合规定."))
		End if 

		Set oInfo = nothing 

	else
		call action_info_add_html(postarr)
	End if 
End Sub 
Sub action_info_edit()
	Dim postarr(13,0),oInfo,info_id
	Set oInfo = new Info
	oInfo.PInfoMdb	= ConstDBtablearr(1)
	info_id = killint(trim(request("id")),0,0,5)

	'	redim postarr(10)'preserve
	if trim(request("submit"))<>"" then 
		Dim info_title,info_content,cat_id,info_weather,info_rank,info_level,info_htmlorubb,info_tags,info_filename
		info_title = request("info_title")
		cat_id = killint(trim(request("cat_id")),0,0,5)
		info_rank = killint(trim(request("info_rank")),0,0,5)
		info_weather = killint(trim(request("info_weather")),0,0,5)
		
		info_level = killint(trim(request("info_level")),0,0,5)
		info_htmlorubb = killint(trim(request("info_ubbhtml")),0,0,5)
		if info_htmlorubb = 0  then
			info_content= request("message")'UBB格式
		else
			info_content =  request("info_content")
		End if 

		info_tags = Left(request("form_tags"),250)
		info_filename = Left(request("form_htmlfile"),250)

		if oInfo.Edit(Array(info_id,cat_id,GetUserData(UserLoginID),info_level,info_title,info_weather,info_rank,info_content,GetIp(),info_htmlorubb,info_filename,info_tags)) then 
			
		If NeedHtmlPage Then 
		'更新静态页面

			'更新HTML
			oInfo.CreateXmlFile( info_id )'创建XML文件
			Call CreateInfomationItemHtml( info_id ,True )	'
			Tpl.Assign "MustPageAll",True    '只关心栏目的首页就可以了...
			Tpl.Assign "StopPageNumber",2   '中止页数设置成2，保证不叠加...
			'更新相关栏目页面
			Dim iPosParentIDs,iPosChildIDs,iPosCIDs
			iPosChildIDs = GetWithChildsInIDs( cat_id )
			iPosParentIDs = GetWithParentsInIDs( cat_id )
			
			iPosCIDs = RemoveTrim(Replace(Replace( Replace(Replace(Replace( iPosChildIDs & iPosParentIDs ,")","," ),"(",","),",,",","),"0,",""), cat_id& ",",""),",")
			Dim newCArrays,cIDIns
			newCArrays=Split(iPosCIDs,",")
			For each cIDIns In newCArrays
				If(IsInteger(cIDIns)) Then 
					Call Tpl.Assign("SectedID",cIDIns)
					Call CreateCemplateHtml(server.mappath("../") & "\" & "template\dir-index.asp",True )
				End If 
			Next
			'更新本栏目页面

			Call Tpl.Assign("SectedID",cat_id)
			Call CreateCemplateHtml(server.mappath("../") & "\" & "template\dir-index.asp",True )

			'更新代码结束
		End If 

			response.write (CoutError(1,"操作成功,3秒后返回"))
			response.write (CoutError(6,"default.asp?action=info"))
		else
			response.write (CoutError(9,"操作失败,可能由于字段不合规定."))
		End if 


	else
		Dim editarrs
		editarrs = oInfo.GetById(info_id)
		if not isarray(editarrs) then 
			response.write (CoutError(1,"获取基本数据失败,3秒后返回"))
			response.write (CoutError(6,"default.asp?action=info"))
		else 
			call action_info_add_html(editarrs)
		End if 
	End if 
		Set oInfo = nothing 
End Sub 
Function action_info_bak()
	Dim strID,oInfo,bak_key,objt
	bak_key = killint(Request("bak_key"),0,0,10)
	if bak_key = 7 then
		Set objt = new Reply
		objt.PThisMdb	= ConstDBtablearr(3)

	else
		Set oInfo = new Info
		oInfo.PInfoMdb	= ConstDBtablearr(1)

		Set objt = new Reply
		objt.PThisMdb	= ConstDBtablearr(3)

	End if 


	
	For  Each    strID  In  Request("id")  
		if bak_key = 2 then '删除
			DeleteFile(Tpl.GetValue("BasePath") & oInfo.GetFullPath(strID))
			oInfo.Delete(killint(strID,0,0,10))
			objt.DeleteFromInfo(killint(strID,0,0,10))
		ElseIf bak_key = 1 then '生成
			If NeedHtmlPage Then 
				oInfo.CreateXmlFile(killint(strID,0,0,10))'创建XML文件
				Call CreateInfomationItemHtml( killint(strID,0,0,10)  ,True )	
			Else
				Response.Write("<br/>静态页生成已被关闭<br/>")
			End If 
		ElseIf bak_key = 7 Then '删除评论
			objt.Delete(killint(strID,0,0,10))
		End If 
			response.write("编号"&strID&"操作成功<br/>")
	Next

		response.write CoutError(1,"批量操作成功,3秒后返回上一页")
	if bak_key = 7 then
		response.write CoutError(6,"default.asp?action=info&that=reply")
		Set objt = nothing 
	else
		response.write CoutError(6,"default.asp?action=info")
		Set objt = nothing 
		Set oInfo = nothing 
	End if 
End Function 
Sub  action_info_delete()
	Dim strID,oInfo
	Set oInfo = new Info
	oInfo.PInfoMdb	= ConstDBtablearr(1)

	For  Each    strID  In  Request("id")  
		DeleteFile(Tpl.GetValue("BasePath") & oInfo.GetFullPath(strID))
		oInfo.Delete(killint(strID,0,0,10))
		response.write("编号"&strID&"操作成功<br/>")
	Next
		response.write CoutError(1,"操作成功,3秒后返回上一页")
		response.write CoutError(6,"default.asp?action=info")

		Set oInfo = nothing 

End Sub 
'用户管理

Function action_user()
	Dim sthat
	sthat = trim(request("that"))
	select case sthat
		case "add"		:call action_user_add()
		case "edit"		:call action_user_edit()
		case "delete"	:call action_user_delete()
		case "bak"		:call action_user_bak()
		Case Else		:call action_user_list()
	End select 
End Function 

sub action_user_list()
		Dim objtemp,ainfoarr,stablemess,ir,user_level,page
		Set objtemp = new User
		objtemp.PThisMdb	= ConstDBtablearr(2)
		objtemp.pPageLimit	= PageLimit

		user_level = killint(trim(request("user_level")),0,0,5)
		page = killint(trim(request("page")),0,0,10)

		ainfoarr = objtemp.GetLimitInfo(page,user_level)
		if not isarray(ainfoarr) then 
			response.write (CoutError(1,"查询无数据记录"))
			exit sub
		End if
		stablemess	= "<form name='form' action='default.asp?action=user&that=bak' method='post'><table width='100%' class='tablelist' border='0' align='center' cellpadding='3' cellspacing='1' ><tr class='tableheader' ><td width='5%'>序号</td><td width='20%'>用户名</td><td width='15%'>权限</td><td width='40%'>电子邮件</td><td width='15%'>操作</td><td width='5%'><input  type='checkbox'  name='chkall'  value='on'  onclick='CheckAll(this.form)'></td></tr>"

		for ir = 0 to ubound(ainfoarr,2)
			stablemess = stablemess & "<tr class='tabletr' ><td>"&ainfoarr(0,ir)&"</td><td>"&ainfoarr(1,ir)&"</td><td><a href='default.asp?action=user&page="&page&"&user_level="&ainfoarr(2,ir)&"'>"&ainfoarr(2,ir)&"</a></td><td align='left'>"&ainfoarr(3,ir)&"</td><td><a href='default.asp?action=user&that=edit&id="&ainfoarr(0,ir)&"'><img src='../images/admin/edit.gif'  border='0' alt='操作'></a>&nbsp;<a href='default.asp?action=user&that=delete&id="&ainfoarr(0,ir)&"'  onClick=""return cofimstr('进行删除操作么');""><img src='../images/admin/delete.gif'  border='0' alt='删除'></a></td><td><input name='id' type='checkbox' value='"&ainfoarr(0,ir)&"'></td></tr>"
		next
		Dim pageall:pageall= objtemp.GetAllResult(user_level)

		stablemess = stablemess &"<tr><td colspan='7' class='tablespan' >"&PageInfo(GetPageCount(pageall,PageLimit),PageLimit,page,pageall)&"<input type='radio' name='bak_key' value='2'>删除<input type='submit' name='Submit' class='submit' value='批处理' onClick=""return cofimstr('进行批处理么');""></td></tr></table></form>"
		response.write(stablemess)
		Set objtemp = nothing 
	
End Sub

Sub action_user_add()
		if len(trim(request("submit"))) = 0  then 
			Dim arrs 
			redim arrs(5,0)
			call action_user_html(arrs)
		else'提交数据库，更新数据库
			Dim objtemp
			Set objtemp = new User
			objtemp.PThisMdb	= ConstDBtablearr(2)'栏目的表格
			Dim user_name,user_password,user_level,user_email
			user_name = left(trim(request("user_name")),250)
			user_password = MD5(left(trim(request("user_password")),250))
			user_level = killint(trim(request("user_level")),0,0,5)
			user_email = left(left(trim(request("user_email")),50),250)
			
			if len(user_name)< BaseUserLen then 
				response.write (CoutError(9,"用户名太短了"))
				exit Sub
			elseif not IsValidEmail(user_email) then 
				response.write (CoutError(9,"电子邮件不合法"))
				exit Sub
			End if


			if objtemp.addnew(Array(0,user_name,user_password,user_level,user_email)) then 
				response.write (CoutError(1,"操作成功,3秒后返回上一页"))
			else
				response.write (CoutError(9,"操作失败,可能用户名已经存在"))
			End if 
			response.write (CoutError(6,"default.asp?action=user"))
		End if
		Set objtemp = nothing 

End Sub 
Sub action_user_edit()
		Dim objtemp
		Set objtemp = new User
		objtemp.PThisMdb	= ConstDBtablearr(2)'栏目的表格
		Dim arrs,rid
		rid=killint(request("id"),0,0,10)
		if len(trim(request("submit"))) = 0  then 
			arrs= objtemp.GetById(rid)
			if not isarray(arrs) then 
				response.write (CoutError(1,"获取数据失败"))
				exit Sub 
			End if 
			call action_user_html(arrs)
		else'提交数据库，更新数据库
		Dim user_name,user_password,user_level,user_email
		user_name = left(trim(request("user_name")),250)
		user_password = left(trim(request("user_password")),250)
		user_level = killint(trim(request("user_level")),0,0,5)
		user_email = left(left(trim(request("user_email")),50),250)
		if len(user_password) <> 0 then user_password = MD5(user_password)

			if len(user_name)< BaseUserLen then 
				response.write (CoutError(9,"用户名太短了"))
				exit Sub
			elseif not IsValidEmail(user_email) then 
				response.write (CoutError(9,"电子邮件不合法"))
				exit Sub
			End if


		if objtemp.Edit(Array(rid,user_name,user_password,user_level,user_email)) then 
			response.write (CoutError(1,"操作成功,3秒后返回用户列表"))
		else
			response.write (CoutError(9,"操作失败,可能用户名已经存在"))
		End if 
			response.write (CoutError(6,"default.asp?action=user"))
		End if
		Set objtemp = nothing 

End Sub 
Sub action_user_bak()
	Dim strID,objtemp,bakType
	Set objtemp = new User
	objtemp.PThisMdb	= ConstDBtablearr(2)
	
	bakType=killint(request("bak_key"),0,0,3)
	For  Each    strID  In  Request("id")  
		If(bakType=2) Then 
		if GetUserData(UserLoginID) <> killint(strID,0,0,10) then '不能删除自己
			objtemp.Delete(killint(strID,0,0,10))
			response.write("编号"&strID&"操作（删除）成功<br/>")
		else
			response.write("编号"&strID&"操作（删除）失败，无法删除您自己的登陆帐号.<br/>")
		End If
		End If 
	Next
		response.write CoutError(1,"操作成功,3秒后返回")
		response.write CoutError(6,"default.asp?action=user")

		Set objtemp = nothing 
End Sub 

Sub action_user_delete()
	Dim strID,objtemp
	Set objtemp = new User
	objtemp.PThisMdb	= ConstDBtablearr(2)

	For  Each    strID  In  Request("id")  
		if GetUserData(UserLoginID) <> killint(strID,0,0,10) then '不能删除自己
			objtemp.Delete(killint(strID,0,0,10))
			response.write("编号"&strID&"操作成功<br/>")
		else
			response.write("编号"&strID&"操作失败，无法清楚您自己的登陆帐号.<br/>")
		End if
	Next
		response.write CoutError(1,"操作成功,3秒后返回用户列表")
		response.write CoutError(6,"default.asp?action=user")

		Set objtemp = nothing 

End Sub 



'友情链接管理
Function action_link()
	Dim sthat
	sthat = trim(request("that"))
	select case sthat
		case "add"		:call action_link_add()
		case "edit"		:call action_link_edit()
		case "delete"	:call action_link_delete()
		Case Else		:call action_link_list()
	End select 
End Function 

Sub  action_link_list()
		Dim tempobj,acatarr,stablemess,ir
		Set tempobj = new Link
		tempobj.PThisMdb	= ConstDBtablearr(4)

		acatarr = tempobj.GetCatAll()
		stablemess	= "<form name='form' action='default.asp?action=link&that=delete' method='post'><table width='100%' class='tablelist' border='0' align='center' cellpadding='3' cellspacing='1' ><tr class='tableheader' ><td width='5%'>序号</td><td width='20%'>名称</td><td width='40%'>地址</td><td width='5%'>级别</td><td width='20%'>图片</td><td width='5%'>操作</td><td width='5%'><input  type='checkbox'  name='chkall'  value='on'  onclick='CheckAll(this.form)'></td></tr>"
		If(IsArray(acatarr)) Then 
		for ir = 0 to ubound(acatarr,2)
			Dim strLogo
			If(len(acatarr(4,ir))>(7+5)) Then 
				strLogo="<img src="" " & acatarr(4,ir) & """>" 
			Else
				strLogo= " "
			End If 

			stablemess = stablemess & "<tr class='tabletr' ><td>"&acatarr(0,ir)&"</td><td align='left'><a href="&acatarr(2,ir)&" target='_blank'>"&acatarr(1,ir)&"</a></td><td align='left'>"&acatarr(2,ir)&"</td><td>"&acatarr(3,ir)&"</td><td>"& strLogo &"</td><td><a href='default.asp?action=link&that=edit&id="&acatarr(0,ir)&"'><img src='../images/admin/edit.gif'  border='0' alt='操作'></a></td><td><input name='id' type='checkbox' value='"&acatarr(0,ir)&"'></td></tr>"
		Next
		stablemess = stablemess &"<tr><td colspan='7' class='tablespan'>Have all "&ubound(acatarr,2)+1&" results. <input type='radio' name='bak_key' value='1'>删除<input type='radio' name='bak_key' value='0' style='display:none'> <input type='submit' name='Submit' class='submit' value='批处理' onClick=""return cofimstr('进行批处理么');""></td></tr>"
		End If 
		stablemess = stablemess & "</table></form>"
		response.write(stablemess)
		Set tempobj = nothing 
End Sub  
Sub action_link_delete()
		Dim tempobj,strID,bak_key
		Set tempobj = new Link
		tempobj.PThisMdb	= ConstDBtablearr(4)
		
		bak_key = killint(Request("bak_key"),0,0,10)

	For  Each    strID  In  Request("id")  
		if bak_key = 1 then '删除
			tempobj.Delete(killint(strID,0,0,10))
		End if 
		response.write("编号"&strID&"操作成功<br/>")
	Next

		response.write (CoutError(1,"操作成功,3秒后返回友情链接列表"))
		Set tempobj = nothing 
		response.write (CoutError(6,"default.asp?action=link"))
End Sub 
Sub action_link_add()
	if trim(request("submit"))<>"" then 
		Dim objtemp
		Set objtemp = new Link
		objtemp.PThisMdb	= ConstDBtablearr(4)'栏目的表格
		Dim link_title,link_url,link_level,link_logo
		link_title = left(trim(request("link_title")),250)
		link_url = left(trim(request("link_url")),250)
		link_level = killint(trim(request("link_level")),0,0,5)
		link_logo = left(left(trim(request("link_logo")),50),250)
		if killint(trim(request("cat_other")),0,0,5)=0 then link_logo=""

			if objtemp.AddNew(Array(0,link_title,link_url,link_level,link_logo)) then 
				response.write (CoutError(1,"操作成功,3秒后返回上一页"))
			else
				response.write (CoutError(9,"操作失败"))
			End if 
			response.write (CoutError(6,"default.asp?action=link"))
		Set objtemp = nothing 

	else
		Dim arrs()
		redim arrs(5,0)
			call action_link_html(arrs)
	End if 
End Sub 
Sub action_link_edit()
		Dim objtemp
		Set objtemp = new Link
		objtemp.PThisMdb	= ConstDBtablearr(4)'栏目的表格
		Dim arrs,rid
		rid=killint(request("id"),0,0,10)
		if len(trim(request("submit"))) = 0  then 
			arrs= objtemp.GetById(rid)
			if not isarray(arrs) then 
				response.write (CoutError(1,"获取数据失败"))
				exit Sub 
			End if 
			call action_link_html(arrs)
		else'提交数据库，更新数据库
		Dim link_title,link_url,link_level,link_logo
		link_title = left(trim(request("link_title")),250)
		link_url = left(trim(request("link_url")),250)
		link_level = killint(trim(request("link_level")),0,0,5)
		link_logo = left(left(trim(request("link_logo")),50),250)
		if killint(trim(request("cat_other")),0,0,5)=0 then link_logo=""

		if objtemp.Edit(Array(rid,link_title,link_url,link_level,link_logo)) then 
			response.write (CoutError(1,"操作成功,3秒后返回上一页"))
		else
			response.write (CoutError(9,"操作失败"))
		End if 
			response.write (CoutError(6,"default.asp?action=link"))
		End if
		Set objtemp = nothing 
End Sub 

'============================================================















';;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Function  ShowSpaceInfo(drvpath)
On Error Resume next
	dim fso,d,size,showsize
	set fso=server.createobject("scripting.filesystemobject") 		
	drvpath=server.mappath(drvpath) 		 		
	set d=fso.getfolder(drvpath) 		
	size=d.size
	showsize=size
	   size=(size\1024)
	   showsize=size 
	   size=(size/1024)
	   showsize=formatnumber(size,2)
	ShowSpaceInfo= showsize 
End Function

Function Drawbar(path)
Dim xall,yall
xall=ShowSpaceInfo("../")
yall=ShowSpaceInfo(path)
Drawbar=Yall/Xall*100
End Function 	
Function CreateInfomationItemHtml(id,isNeedStrMessage)
	Tpl.Assign "ItemID",id
	Dim oInfo
	Set oInfo = new Info
	oInfo.PInfoMdb	= ConstDBtablearr(1)
	If(Not oInfo.ExistID(id)) Then Exit Function 
	Tpl.Assign "ItemPath",oInfo.GetFullPath(id)
	Dim aspFile 
	aspFile = Tpl.GetValue("BasePath") & "template\item.asp"
	on error resume Next
	If isNeedStrMessage Then response.write("处理模板" & aspFile )
	If(FileExists( aspFile )) Then 
		execute(GetFileContent(aspFile))
	End If 
	If Err Then
		If isNeedStrMessage Then  response.write ("<font  color=""red"">发生错误:  &nbsp;"&Err.Number &"，描述：" &err.Description & "</font><br />")
		err.Clear
	Else
		If isNeedStrMessage Then  response.write("<font  color=""blue"">生成</font><br />"    )
	End If 

End Function 

Function CreateCemplateHtml(aspFile,isNeedStrMessage)
	'response.write (Tpl.InvokeXmlFileByXsl(baseDirTemp & "cache\xml\docs\14.xml",baseDirTemp & "cache\xsl\test.xsl"))
'	'response.write (Tpl.Fetch(baseDirTemp & "cache\cemplate\default.html"))
	'on error resume Next
	If isNeedStrMessage Then response.write("处理模板" & aspFile )
	If(FileExists( aspFile )) Then 
		execute(GetFileContent(aspFile))
	End If 
	If Err Then
		If isNeedStrMessage Then response.write ("<font  color=""red"">发生错误:  &nbsp;"&Err.Number &"，描述：" &err.Description & "</font><br />")
		err.Clear
	Else
		If isNeedStrMessage Then response.write("<font  color=""blue"">生成</font><br />"    )
	End If 

End Function 

%>